home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / DB_File / DB_File.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-02-02  |  28.4 KB  |  1,449 lines  |  [TEXT/MPS ]
  1. /* 
  2.  
  3.  DB_File.xs -- Perl 5 interface to Berkeley DB 
  4.  
  5.  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
  6.  last modified 23rd June 1994
  7.  version 0.1
  8.  
  9.  All comments/suggestions/problems are welcome
  10.  
  11. */
  12.  
  13. #include "EXTERN.h"  
  14. #include "perl.h"
  15. #include "XSUB.h"
  16.  
  17. #include <db.h>
  18.  
  19. #include <fcntl.h> 
  20.  
  21. #ifndef DBXS_HASH_TYPE
  22. #define DBXS_HASH_TYPE u_int
  23. #endif
  24.  
  25. #ifndef DBXS_PREFIX_TYPE
  26. #define DBXS_PREFIX_TYPE size_t
  27. #endif
  28.  
  29. typedef DB * DB_File;
  30. typedef DBT DBTKEY ;
  31.  
  32. union INFO {
  33.         HASHINFO     hash ;
  34.         RECNOINFO     recno ;
  35.         BTREEINFO     btree ;
  36.       } ;
  37.  
  38. typedef struct {
  39.         SV *    sub ;
  40.     } CallBackInfo ;
  41.  
  42.  
  43. /* #define TRACE  */
  44.  
  45. #define db_DESTROY(db)                  (db->close)(db)
  46. #define db_DELETE(db, key, flags)       (db->del)(db, &key, flags)
  47. #define db_STORE(db, key, value, flags) (db->put)(db, &key, &value, flags)
  48. #define db_FETCH(db, key, flags)        (db->get)(db, &key, &value, flags)
  49.  
  50. #define db_close(db)            (db->close)(db)
  51. #define db_del(db, key, flags)          (db->del)(db, &key, flags)
  52. #define db_fd(db)                       (db->fd)(db) 
  53. #define db_put(db, key, value, flags)   (db->put)(db, &key, &value, flags)
  54. #define db_get(db, key, value, flags)   (db->get)(db, &key, &value, flags)
  55. #define db_seq(db, key, value, flags)   (db->seq)(db, &key, &value, flags)
  56. #define db_sync(db, flags)              (db->sync)(db, flags)
  57.  
  58.  
  59. #define OutputValue(arg, name)  \
  60.     { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
  61.  
  62. #define OutputKey(arg, name)                     \
  63.     { if (RETVAL == 0) \
  64.       {                             \
  65.         if (db->close != DB_recno_close)         \
  66.             sv_setpvn(arg, name.data, name.size);     \
  67.         else                         \
  68.             sv_setiv(arg, (I32)*(I32*)name.data - 1);     \
  69.       }                             \
  70.     }
  71.  
  72. /* Internal Global Data */
  73.  
  74. static recno_t Value ;
  75. static int (*DB_recno_close)() = NULL ;
  76.  
  77. static CallBackInfo hash_callback     = { 0 } ;
  78. static CallBackInfo compare_callback     = { 0 } ;
  79. static CallBackInfo prefix_callback     = { 0 } ;
  80.  
  81.  
  82. static int
  83. btree_compare(key1, key2)
  84. const DBT * key1 ;
  85. const DBT * key2 ;
  86. {
  87.     dSP ;
  88.     void * data1, * data2 ;
  89.     int retval ;
  90.     int count ;
  91.     
  92.     data1 = key1->data ;
  93.     data2 = key2->data ;
  94.  
  95.     /* As newSVpv will assume that the data pointer is a null terminated C 
  96.        string if the size parameter is 0, make sure that data points to an 
  97.        empty string if the length is 0
  98.     */
  99.     if (key1->size == 0)
  100.         data1 = "" ; 
  101.     if (key2->size == 0)
  102.         data2 = "" ;
  103.  
  104.     ENTER ;
  105.     SAVETMPS;
  106.  
  107.     PUSHMARK(sp) ;
  108.     EXTEND(sp,2) ;
  109.     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
  110.     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
  111.     PUTBACK ;
  112.  
  113.     count = perl_call_sv(compare_callback.sub, G_SCALAR); 
  114.  
  115.     SPAGAIN ;
  116.  
  117.     if (count != 1)
  118.         croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
  119.  
  120.     retval = POPi ;
  121.  
  122.     PUTBACK ;
  123.     FREETMPS ;
  124.     LEAVE ;
  125.     return (retval) ;
  126.  
  127. }
  128.  
  129. static DBXS_PREFIX_TYPE
  130. btree_prefix(key1, key2)
  131. const DBT * key1 ;
  132. const DBT * key2 ;
  133. {
  134.     dSP ;
  135.     void * data1, * data2 ;
  136.     int retval ;
  137.     int count ;
  138.     
  139.     data1 = key1->data ;
  140.     data2 = key2->data ;
  141.  
  142.     /* As newSVpv will assume that the data pointer is a null terminated C 
  143.        string if the size parameter is 0, make sure that data points to an 
  144.        empty string if the length is 0
  145.     */
  146.     if (key1->size == 0)
  147.         data1 = "" ;
  148.     if (key2->size == 0)
  149.         data2 = "" ;
  150.  
  151.     ENTER ;
  152.     SAVETMPS;
  153.  
  154.     PUSHMARK(sp) ;
  155.     EXTEND(sp,2) ;
  156.     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
  157.     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
  158.     PUTBACK ;
  159.  
  160.     count = perl_call_sv(prefix_callback.sub, G_SCALAR); 
  161.  
  162.     SPAGAIN ;
  163.  
  164.     if (count != 1)
  165.         croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
  166.  
  167.     retval = POPi ;
  168.  
  169.     PUTBACK ;
  170.     FREETMPS ;
  171.     LEAVE ;
  172.  
  173.     return (retval) ;
  174. }
  175.  
  176. static DBXS_HASH_TYPE
  177. hash_cb(data, size)
  178. const void * data ;
  179. size_t size ;
  180. {
  181.     dSP ;
  182.     int retval ;
  183.     int count ;
  184.  
  185.     if (size == 0)
  186.         data = "" ;
  187.  
  188.     PUSHMARK(sp) ;
  189.     XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
  190.     PUTBACK ;
  191.  
  192.     count = perl_call_sv(hash_callback.sub, G_SCALAR); 
  193.  
  194.     SPAGAIN ;
  195.  
  196.     if (count != 1)
  197.         croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
  198.  
  199.     retval = POPi ;
  200.  
  201.     PUTBACK ;
  202.     FREETMPS ;
  203.     LEAVE ;
  204.  
  205.     return (retval) ;
  206. }
  207.  
  208.  
  209. #ifdef TRACE
  210.  
  211. static void
  212. PrintHash(hash)
  213. HASHINFO hash ;
  214. {
  215.     printf ("HASH Info\n") ;
  216.     printf ("  hash      = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
  217.     printf ("  bsize     = %d\n", hash.bsize) ;
  218.     printf ("  ffactor   = %d\n", hash.ffactor) ;
  219.     printf ("  nelem     = %d\n", hash.nelem) ;
  220.     printf ("  cachesize = %d\n", hash.cachesize) ;
  221.     printf ("  lorder    = %d\n", hash.lorder) ;
  222.  
  223. }
  224.  
  225. static void
  226. PrintRecno(recno)
  227. RECNOINFO recno ;
  228. {
  229.     printf ("RECNO Info\n") ;
  230.     printf ("  flags     = %d\n", recno.flags) ;
  231.     printf ("  cachesize = %d\n", recno.cachesize) ;
  232.     printf ("  psize     = %d\n", recno.psize) ;
  233.     printf ("  lorder    = %d\n", recno.lorder) ;
  234.     printf ("  reclen    = %d\n", recno.reclen) ;
  235.     printf ("  bval      = %d\n", recno.bval) ;
  236.     printf ("  bfname    = %s\n", recno.bfname) ;
  237. }
  238.  
  239. PrintBtree(btree)
  240. BTREEINFO btree ;
  241. {
  242.     printf ("BTREE Info\n") ;
  243.     printf ("  compare    = %s\n", (btree.compare ? "redefined" : "default")) ;
  244.     printf ("  prefix     = %s\n", (btree.prefix ? "redefined" : "default")) ;
  245.     printf ("  flags      = %d\n", btree.flags) ;
  246.     printf ("  cachesize  = %d\n", btree.cachesize) ;
  247.     printf ("  psize      = %d\n", btree.psize) ;
  248.     printf ("  maxkeypage = %d\n", btree.maxkeypage) ;
  249.     printf ("  minkeypage = %d\n", btree.minkeypage) ;
  250.     printf ("  lorder     = %d\n", btree.lorder) ;
  251. }
  252.  
  253. #else
  254.  
  255. #define PrintRecno(recno)
  256. #define PrintHash(hash)
  257. #define PrintBtree(btree)
  258.  
  259. #endif /* TRACE */
  260.  
  261.  
  262. static I32
  263. GetArrayLength(db)
  264. DB_File db ;
  265. {
  266.     DBT        key ;
  267.     DBT        value ;
  268.     int        RETVAL ;
  269.  
  270.     RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
  271.     if (RETVAL == 0)
  272.         RETVAL = *(I32 *)key.data ;
  273.     else if (RETVAL == 1) /* No key means empty file */
  274.         RETVAL = 0 ;
  275.  
  276.     return (RETVAL) ;
  277. }
  278.  
  279. static DB_File
  280. ParseOpenInfo(name, flags, mode, sv, string)
  281. char * name ;
  282. int    flags ;
  283. int    mode ;
  284. SV *   sv ;
  285. char * string ;
  286. {
  287.     SV **    svp;
  288.     HV *    action ;
  289.     union INFO    info ;
  290.     DB_File    RETVAL ;
  291.     void *    openinfo = NULL ;
  292.     DBTYPE    type = DB_HASH ;
  293.  
  294.  
  295.     if (sv)
  296.     {
  297.         if (! SvROK(sv) )
  298.             croak ("type parameter is not a reference") ;
  299.  
  300.         action = (HV*)SvRV(sv);
  301.         if (sv_isa(sv, "DB_File::HASHINFO"))
  302.         {
  303.             type = DB_HASH ;
  304.             openinfo = (void*)&info ;
  305.   
  306.             svp = hv_fetch(action, "hash", 4, FALSE); 
  307.  
  308.             if (svp && SvOK(*svp))
  309.             {
  310.                 info.hash.hash = hash_cb ;
  311.         hash_callback.sub = *svp ;
  312.             }
  313.             else
  314.             info.hash.hash = NULL ;
  315.  
  316.            svp = hv_fetch(action, "bsize", 5, FALSE);
  317.            info.hash.bsize = svp ? SvIV(*svp) : 0;
  318.            
  319.            svp = hv_fetch(action, "ffactor", 7, FALSE);
  320.            info.hash.ffactor = svp ? SvIV(*svp) : 0;
  321.          
  322.            svp = hv_fetch(action, "nelem", 5, FALSE);
  323.            info.hash.nelem = svp ? SvIV(*svp) : 0;
  324.          
  325.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  326.            info.hash.cachesize = svp ? SvIV(*svp) : 0;
  327.          
  328.            svp = hv_fetch(action, "lorder", 6, FALSE);
  329.            info.hash.lorder = svp ? SvIV(*svp) : 0;
  330.  
  331.            PrintHash(info) ; 
  332.         }
  333.         else if (sv_isa(sv, "DB_File::BTREEINFO"))
  334.         {
  335.             type = DB_BTREE ;
  336.             openinfo = (void*)&info ;
  337.    
  338.             svp = hv_fetch(action, "compare", 7, FALSE);
  339.             if (svp && SvOK(*svp))
  340.             {
  341.                 info.btree.compare = btree_compare ;
  342.                 compare_callback.sub = *svp ;
  343.             }
  344.             else
  345.                 info.btree.compare = NULL ;
  346.  
  347.             svp = hv_fetch(action, "prefix", 6, FALSE);
  348.             if (svp && SvOK(*svp))
  349.             {
  350.                 info.btree.prefix = btree_prefix ;
  351.                 prefix_callback.sub = *svp ;
  352.             }
  353.             else
  354.                 info.btree.prefix = NULL ;
  355.  
  356.             svp = hv_fetch(action, "flags", 5, FALSE);
  357.             info.btree.flags = svp ? SvIV(*svp) : 0;
  358.    
  359.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  360.             info.btree.cachesize = svp ? SvIV(*svp) : 0;
  361.          
  362.             svp = hv_fetch(action, "minkeypage", 10, FALSE);
  363.             info.btree.minkeypage = svp ? SvIV(*svp) : 0;
  364.         
  365.             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
  366.             info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
  367.  
  368.             svp = hv_fetch(action, "psize", 5, FALSE);
  369.             info.btree.psize = svp ? SvIV(*svp) : 0;
  370.          
  371.             svp = hv_fetch(action, "lorder", 6, FALSE);
  372.             info.btree.lorder = svp ? SvIV(*svp) : 0;
  373.  
  374.             PrintBtree(info) ;
  375.          
  376.         }
  377.         else if (sv_isa(sv, "DB_File::RECNOINFO"))
  378.         {
  379.             type = DB_RECNO ;
  380.             openinfo = (void *)&info ;
  381.  
  382.             svp = hv_fetch(action, "flags", 5, FALSE);
  383.             info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
  384.          
  385.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  386.             info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
  387.          
  388.             svp = hv_fetch(action, "psize", 5, FALSE);
  389.             info.recno.psize = (int) svp ? SvIV(*svp) : 0;
  390.          
  391.             svp = hv_fetch(action, "lorder", 6, FALSE);
  392.             info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
  393.          
  394.             svp = hv_fetch(action, "reclen", 6, FALSE);
  395.             info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
  396.          
  397.         svp = hv_fetch(action, "bval", 4, FALSE);
  398.             if (svp && SvOK(*svp))
  399.             {
  400.                 if (SvPOK(*svp))
  401.             info.recno.bval = (u_char)*SvPV(*svp, na) ;
  402.         else
  403.             info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
  404.             }
  405.             else
  406.          {
  407.         if (info.recno.flags & R_FIXEDLEN)
  408.                     info.recno.bval = (u_char) ' ' ;
  409.         else
  410.                     info.recno.bval = (u_char) '\n' ;
  411.         }
  412.          
  413.             svp = hv_fetch(action, "bfname", 6, FALSE); 
  414.             info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
  415.  
  416.             PrintRecno(info) ;
  417.         }
  418.         else
  419.             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
  420.     }
  421.  
  422.  
  423.     RETVAL = dbopen(name, flags, mode, type, openinfo) ; 
  424.  
  425.     if (RETVAL == 0)
  426.         croak("DB_File::%s failed, reason: %s", string, Strerror(errno)) ;
  427.  
  428.     /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
  429.                so remember a DB_RECNO by saving the address
  430.                of one of it's internal routines
  431.     */
  432.     if (type == DB_RECNO)
  433.         DB_recno_close = RETVAL->close ;
  434.  
  435.  
  436.     return (RETVAL) ;
  437. }
  438.  
  439.  
  440. static int
  441. not_here(s)
  442. char *s;
  443. {
  444.     croak("DB_File::%s not implemented on this architecture", s);
  445.     return -1;
  446. }
  447.  
  448. static double 
  449. constant(name, arg)
  450. char *name;
  451. int arg;
  452. {
  453.     errno = 0;
  454.     switch (*name) {
  455.     case 'A':
  456.     break;
  457.     case 'B':
  458.     if (strEQ(name, "BTREEMAGIC"))
  459. #ifdef BTREEMAGIC
  460.         return BTREEMAGIC;
  461. #else
  462.         goto not_there;
  463. #endif
  464.     if (strEQ(name, "BTREEVERSION"))
  465. #ifdef BTREEVERSION
  466.         return BTREEVERSION;
  467. #else
  468.         goto not_there;
  469. #endif
  470.     break;
  471.     case 'C':
  472.     break;
  473.     case 'D':
  474.     if (strEQ(name, "DB_LOCK"))
  475. #ifdef DB_LOCK
  476.         return DB_LOCK;
  477. #else
  478.         goto not_there;
  479. #endif
  480.     if (strEQ(name, "DB_SHMEM"))
  481. #ifdef DB_SHMEM
  482.         return DB_SHMEM;
  483. #else
  484.         goto not_there;
  485. #endif
  486.     if (strEQ(name, "DB_TXN"))
  487. #ifdef DB_TXN
  488.         return (U32)DB_TXN;
  489. #else
  490.         goto not_there;
  491. #endif
  492.     break;
  493.     case 'E':
  494.     break;
  495.     case 'F':
  496.     break;
  497.     case 'G':
  498.     break;
  499.     case 'H':
  500.     if (strEQ(name, "HASHMAGIC"))
  501. #ifdef HASHMAGIC
  502.         return HASHMAGIC;
  503. #else
  504.         goto not_there;
  505. #endif
  506.     if (strEQ(name, "HASHVERSION"))
  507. #ifdef HASHVERSION
  508.         return HASHVERSION;
  509. #else
  510.         goto not_there;
  511. #endif
  512.     break;
  513.     case 'I':
  514.     break;
  515.     case 'J':
  516.     break;
  517.     case 'K':
  518.     break;
  519.     case 'L':
  520.     break;
  521.     case 'M':
  522.     if (strEQ(name, "MAX_PAGE_NUMBER"))
  523. #ifdef MAX_PAGE_NUMBER
  524.         return (U32)MAX_PAGE_NUMBER;
  525. #else
  526.         goto not_there;
  527. #endif
  528.     if (strEQ(name, "MAX_PAGE_OFFSET"))
  529. #ifdef MAX_PAGE_OFFSET
  530.         return MAX_PAGE_OFFSET;
  531. #else
  532.         goto not_there;
  533. #endif
  534.     if (strEQ(name, "MAX_REC_NUMBER"))
  535. #ifdef MAX_REC_NUMBER
  536.         return (U32)MAX_REC_NUMBER;
  537. #else
  538.         goto not_there;
  539. #endif
  540.     break;
  541.     case 'N':
  542.     break;
  543.     case 'O':
  544.     break;
  545.     case 'P':
  546.     break;
  547.     case 'Q':
  548.     break;
  549.     case 'R':
  550.     if (strEQ(name, "RET_ERROR"))
  551. #ifdef RET_ERROR
  552.         return RET_ERROR;
  553. #else
  554.         goto not_there;
  555. #endif
  556.     if (strEQ(name, "RET_SPECIAL"))
  557. #ifdef RET_SPECIAL
  558.         return RET_SPECIAL;
  559. #else
  560.         goto not_there;
  561. #endif
  562.     if (strEQ(name, "RET_SUCCESS"))
  563. #ifdef RET_SUCCESS
  564.         return RET_SUCCESS;
  565. #else
  566.         goto not_there;
  567. #endif
  568.     if (strEQ(name, "R_CURSOR"))
  569. #ifdef R_CURSOR
  570.         return R_CURSOR;
  571. #else
  572.         goto not_there;
  573. #endif
  574.     if (strEQ(name, "R_DUP"))
  575. #ifdef R_DUP
  576.         return R_DUP;
  577. #else
  578.         goto not_there;
  579. #endif
  580.     if (strEQ(name, "R_FIRST"))
  581. #ifdef R_FIRST
  582.         return R_FIRST;
  583. #else
  584.         goto not_there;
  585. #endif
  586.     if (strEQ(name, "R_FIXEDLEN"))
  587. #ifdef R_FIXEDLEN
  588.         return R_FIXEDLEN;
  589. #else
  590.         goto not_there;
  591. #endif
  592.     if (strEQ(name, "R_IAFTER"))
  593. #ifdef R_IAFTER
  594.         return R_IAFTER;
  595. #else
  596.         goto not_there;
  597. #endif
  598.     if (strEQ(name, "R_IBEFORE"))
  599. #ifdef R_IBEFORE
  600.         return R_IBEFORE;
  601. #else
  602.         goto not_there;
  603. #endif
  604.     if (strEQ(name, "R_LAST"))
  605. #ifdef R_LAST
  606.         return R_LAST;
  607. #else
  608.         goto not_there;
  609. #endif
  610.     if (strEQ(name, "R_NEXT"))
  611. #ifdef R_NEXT
  612.         return R_NEXT;
  613. #else
  614.         goto not_there;
  615. #endif
  616.     if (strEQ(name, "R_NOKEY"))
  617. #ifdef R_NOKEY
  618.         return R_NOKEY;
  619. #else
  620.         goto not_there;
  621. #endif
  622.     if (strEQ(name, "R_NOOVERWRITE"))
  623. #ifdef R_NOOVERWRITE
  624.         return R_NOOVERWRITE;
  625. #else
  626.         goto not_there;
  627. #endif
  628.     if (strEQ(name, "R_PREV"))
  629. #ifdef R_PREV
  630.         return R_PREV;
  631. #else
  632.         goto not_there;
  633. #endif
  634.     if (strEQ(name, "R_RECNOSYNC"))
  635. #ifdef R_RECNOSYNC
  636.         return R_RECNOSYNC;
  637. #else
  638.         goto not_there;
  639. #endif
  640.     if (strEQ(name, "R_SETCURSOR"))
  641. #ifdef R_SETCURSOR
  642.         return R_SETCURSOR;
  643. #else
  644.         goto not_there;
  645. #endif
  646.     if (strEQ(name, "R_SNAPSHOT"))
  647. #ifdef R_SNAPSHOT
  648.         return R_SNAPSHOT;
  649. #else
  650.         goto not_there;
  651. #endif
  652.     break;
  653.     case 'S':
  654.     break;
  655.     case 'T':
  656.     break;
  657.     case 'U':
  658.     break;
  659.     case 'V':
  660.     break;
  661.     case 'W':
  662.     break;
  663.     case 'X':
  664.     break;
  665.     case 'Y':
  666.     break;
  667.     case 'Z':
  668.     break;
  669.     case '_':
  670.     if (strEQ(name, "__R_UNUSED"))
  671. #ifdef __R_UNUSED
  672.         return __R_UNUSED;
  673. #else
  674.         goto not_there;
  675. #endif
  676.     break;
  677.     }
  678.     errno = EINVAL;
  679.     return 0;
  680.  
  681. not_there:
  682.     errno = ENOENT;
  683.     return 0;
  684. }
  685.  
  686. XS(XS_DB_File_constant)
  687. {
  688.     dXSARGS;
  689.     if (items != 2) {
  690.     croak("Usage: DB_File::constant(name,arg)");
  691.     }
  692.     {
  693.     char *    name = (char *)SvPV(ST(0),na);
  694.     int    arg = (int)SvIV(ST(1));
  695.     double    RETVAL;
  696.  
  697.     RETVAL = constant(name, arg);
  698.     ST(0) = sv_newmortal();
  699.     sv_setnv(ST(0), (double)RETVAL);
  700.     }
  701.     XSRETURN(1);
  702. }
  703.  
  704. XS(XS_DB_File_db_TIEHASH)
  705. {
  706.     dXSARGS;
  707.     if (items < 1 || items > 5) {
  708.     croak("Usage: DB_File::TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)");
  709.     }
  710.     {
  711.     char *    dbtype = (char *)SvPV(ST(0),na);
  712.     int    flags;
  713.     int    mode;
  714.     DB_File    RETVAL;
  715.  
  716.     if (items < 3)
  717.         flags = O_RDWR;
  718.     else {
  719.         flags = (int)SvIV(ST(2));
  720.     }
  721.  
  722.     if (items < 4)
  723.         mode = 0640;
  724.     else {
  725.         mode = (int)SvIV(ST(3));
  726.     }
  727.     {
  728.         char *    name = (char *) NULL ; 
  729.         SV *    sv = (SV *) NULL ; 
  730.  
  731.         if (items >= 2 && SvOK(ST(1))) 
  732.             name = (char*) SvPV(ST(1), na) ; 
  733.  
  734.             if (items == 5)
  735.             sv = ST(4) ;
  736.  
  737.         RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
  738.     }
  739.     ST(0) = sv_newmortal();
  740.     sv_setref_pv(ST(0), "DB_File", (void*)RETVAL);
  741.     }
  742.     XSRETURN(1);
  743. }
  744.  
  745. XS(XS_DB_File_db_DESTROY)
  746. {
  747.     dXSARGS;
  748.     if (items != 1) {
  749.     croak("Usage: DB_File::DESTROY(db)");
  750.     }
  751.     {
  752.     DB_File    db;
  753.     int    RETVAL;
  754.  
  755.     if (SvROK(ST(0))) {
  756.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  757.         db = (DB_File) tmp;
  758.     }
  759.     else
  760.         croak("db is not a reference");
  761.  
  762.     RETVAL = db_DESTROY(db);
  763.     ST(0) = sv_newmortal();
  764.     sv_setiv(ST(0), (IV)RETVAL);
  765.     }
  766.     XSRETURN(1);
  767. }
  768.  
  769. XS(XS_DB_File_db_DELETE)
  770. {
  771.     dXSARGS;
  772.     if (items < 2 || items > 3) {
  773.     croak("Usage: DB_File::DELETE(db, key, flags=0)");
  774.     }
  775.     {
  776.     DB_File    db;
  777.     DBTKEY    key;
  778.     u_int    flags;
  779.     int    RETVAL;
  780.  
  781.     if (sv_isa(ST(0), "DB_File")) {
  782.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  783.         db = (DB_File) tmp;
  784.     }
  785.     else
  786.         croak("db is not of type DB_File");
  787.  
  788.     if (db->close != DB_recno_close)
  789.     {
  790.         key.data = SvPV(ST(1), na);
  791.         key.size = (int)na;
  792.     }
  793.     else
  794.     {
  795.         Value =  SvIV(ST(1)) ; 
  796.         ++ Value ; 
  797.         key.data = & Value; 
  798.         key.size = (int)sizeof(recno_t);
  799.     };
  800.  
  801.     if (items < 3)
  802.         flags = 0;
  803.     else {
  804.         flags = (unsigned int)SvIV(ST(2));
  805.     }
  806.  
  807.     RETVAL = db_DELETE(db, key, flags);
  808.     ST(0) = sv_newmortal();
  809.     sv_setiv(ST(0), (IV)RETVAL);
  810.     }
  811.     XSRETURN(1);
  812. }
  813.  
  814. XS(XS_DB_File_db_FETCH)
  815. {
  816.     dXSARGS;
  817.     if (items < 2 || items > 3) {
  818.     croak("Usage: DB_File::FETCH(db, key, flags=0)");
  819.     }
  820.     {
  821.     DB_File    db;
  822.     DBTKEY    key;
  823.     u_int    flags;
  824.     int    RETVAL;
  825.  
  826.     if (sv_isa(ST(0), "DB_File")) {
  827.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  828.         db = (DB_File) tmp;
  829.     }
  830.     else
  831.         croak("db is not of type DB_File");
  832.  
  833.     if (db->close != DB_recno_close)
  834.     {
  835.         key.data = SvPV(ST(1), na);
  836.         key.size = (int)na;
  837.     }
  838.     else
  839.     {
  840.         Value =  SvIV(ST(1)) ; 
  841.         ++ Value ; 
  842.         key.data = & Value; 
  843.         key.size = (int)sizeof(recno_t);
  844.     };
  845.  
  846.     if (items < 3)
  847.         flags = 0;
  848.     else {
  849.         flags = (unsigned int)SvIV(ST(2));
  850.     }
  851.     {
  852.         DBT        value  ;
  853.  
  854.         RETVAL = (db->get)(db, &key, &value, flags) ;
  855.         ST(0) = sv_newmortal();
  856.         if (RETVAL == 0)
  857.             sv_setpvn(ST(0), value.data, value.size);
  858.     }
  859.     }
  860.     XSRETURN(1);
  861. }
  862.  
  863. XS(XS_DB_File_db_STORE)
  864. {
  865.     dXSARGS;
  866.     if (items < 3 || items > 4) {
  867.     croak("Usage: DB_File::STORE(db, key, value, flags=0)");
  868.     }
  869.     {
  870.     DB_File    db;
  871.     DBTKEY    key;
  872.     DBT    value;
  873.     u_int    flags;
  874.     int    RETVAL;
  875.  
  876.     if (sv_isa(ST(0), "DB_File")) {
  877.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  878.         db = (DB_File) tmp;
  879.     }
  880.     else
  881.         croak("db is not of type DB_File");
  882.  
  883.     if (db->close != DB_recno_close)
  884.     {
  885.         key.data = SvPV(ST(1), na);
  886.         key.size = (int)na;
  887.     }
  888.     else
  889.     {
  890.         Value =  SvIV(ST(1)) ; 
  891.         ++ Value ; 
  892.         key.data = & Value; 
  893.         key.size = (int)sizeof(recno_t);
  894.     };
  895.  
  896.     value.data = SvPV(ST(2), na);
  897.     value.size = (int)na;;
  898.  
  899.     if (items < 4)
  900.         flags = 0;
  901.     else {
  902.         flags = (unsigned int)SvIV(ST(3));
  903.     }
  904.  
  905.     RETVAL = db_STORE(db, key, value, flags);
  906.     ST(0) = sv_newmortal();
  907.     sv_setiv(ST(0), (IV)RETVAL);
  908.     }
  909.     XSRETURN(1);
  910. }
  911.  
  912. XS(XS_DB_File_db_FIRSTKEY)
  913. {
  914.     dXSARGS;
  915.     if (items != 1) {
  916.     croak("Usage: DB_File::FIRSTKEY(db)");
  917.     }
  918.     {
  919.     DB_File    db;
  920.     int    RETVAL;
  921.  
  922.     if (sv_isa(ST(0), "DB_File")) {
  923.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  924.         db = (DB_File) tmp;
  925.     }
  926.     else
  927.         croak("db is not of type DB_File");
  928.     {
  929.         DBTKEY        key ;
  930.         DBT        value ;
  931.  
  932.         RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;
  933.         ST(0) = sv_newmortal();
  934.         if (RETVAL == 0)
  935.         {
  936.             if (db->type != DB_RECNO)
  937.                 sv_setpvn(ST(0), key.data, key.size);
  938.             else
  939.                 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
  940.         }
  941.     }
  942.     }
  943.     XSRETURN(1);
  944. }
  945.  
  946. XS(XS_DB_File_db_NEXTKEY)
  947. {
  948.     dXSARGS;
  949.     if (items != 2) {
  950.     croak("Usage: DB_File::NEXTKEY(db, key)");
  951.     }
  952.     {
  953.     DB_File    db;
  954.     DBTKEY    key;
  955.     int    RETVAL;
  956.  
  957.     if (sv_isa(ST(0), "DB_File")) {
  958.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  959.         db = (DB_File) tmp;
  960.     }
  961.     else
  962.         croak("db is not of type DB_File");
  963.  
  964.     if (db->close != DB_recno_close)
  965.     {
  966.         key.data = SvPV(ST(1), na);
  967.         key.size = (int)na;
  968.     }
  969.     else
  970.     {
  971.         Value =  SvIV(ST(1)) ; 
  972.         ++ Value ; 
  973.         key.data = & Value; 
  974.         key.size = (int)sizeof(recno_t);
  975.     };
  976.     {
  977.         DBT        value ;
  978.  
  979.         RETVAL = (db->seq)(db, &key, &value, R_NEXT) ;
  980.         ST(0) = sv_newmortal();
  981.         if (RETVAL == 0)
  982.         {
  983.             if (db->type != DB_RECNO)
  984.                 sv_setpvn(ST(0), key.data, key.size);
  985.             else
  986.                 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
  987.         }
  988.     }
  989.     }
  990.     XSRETURN(1);
  991. }
  992.  
  993. XS(XS_DB_File_unshift)
  994. {
  995.     dXSARGS;
  996.     if (items < 1) {
  997.     croak("Usage: DB_File::unshift(db, ...)");
  998.     }
  999.     {
  1000.     DB_File    db;
  1001.     int    RETVAL;
  1002.  
  1003.     if (sv_isa(ST(0), "DB_File")) {
  1004.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1005.         db = (DB_File) tmp;
  1006.     }
  1007.     else
  1008.         croak("db is not of type DB_File");
  1009.     {
  1010.         DBTKEY    key ;
  1011.         DBT        value ;
  1012.         int        i ;
  1013.         int        One ;
  1014.  
  1015.         RETVAL = -1 ;
  1016.         for (i = items-1 ; i > 0 ; --i)
  1017.         {
  1018.             value.data = SvPV(ST(i), na) ;
  1019.             value.size = na ;
  1020.             One = 1 ;
  1021.             key.data = &One ;
  1022.             key.size = sizeof(int) ;
  1023.             RETVAL = (db->put)(db, &key, &value, R_IBEFORE) ;
  1024.             if (RETVAL != 0)
  1025.                 break;
  1026.         }
  1027.     }
  1028.     ST(0) = sv_newmortal();
  1029.     sv_setiv(ST(0), (IV)RETVAL);
  1030.     }
  1031.     XSRETURN(1);
  1032. }
  1033.  
  1034. XS(XS_DB_File_pop)
  1035. {
  1036.     dXSARGS;
  1037.     if (items != 1) {
  1038.     croak("Usage: DB_File::pop(db)");
  1039.     }
  1040.     {
  1041.     DB_File    db;
  1042.     I32    RETVAL;
  1043.  
  1044.     if (sv_isa(ST(0), "DB_File")) {
  1045.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1046.         db = (DB_File) tmp;
  1047.     }
  1048.     else
  1049.         croak("db is not of type DB_File");
  1050.     {
  1051.         DBTKEY    key ;
  1052.         DBT        value ;
  1053.  
  1054.         /* First get the final value */
  1055.         RETVAL = (db->seq)(db, &key, &value, R_LAST) ;    
  1056.         ST(0) = sv_newmortal();
  1057.         /* Now delete it */
  1058.         if (RETVAL == 0)
  1059.         {
  1060.             RETVAL = (db->del)(db, &key, R_CURSOR) ;
  1061.             if (RETVAL == 0)
  1062.                 sv_setpvn(ST(0), value.data, value.size);
  1063.         }
  1064.     }
  1065.     }
  1066.     XSRETURN(1);
  1067. }
  1068.  
  1069. XS(XS_DB_File_shift)
  1070. {
  1071.     dXSARGS;
  1072.     if (items != 1) {
  1073.     croak("Usage: DB_File::shift(db)");
  1074.     }
  1075.     {
  1076.     DB_File    db;
  1077.     I32    RETVAL;
  1078.  
  1079.     if (sv_isa(ST(0), "DB_File")) {
  1080.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1081.         db = (DB_File) tmp;
  1082.     }
  1083.     else
  1084.         croak("db is not of type DB_File");
  1085.     {
  1086.         DBTKEY    key ;
  1087.         DBT        value ;
  1088.  
  1089.         /* get the first value */
  1090.         RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;    
  1091.         ST(0) = sv_newmortal();
  1092.         /* Now delete it */
  1093.         if (RETVAL == 0)
  1094.         {
  1095.             RETVAL = (db->del)(db, &key, R_CURSOR) ;
  1096.             if (RETVAL == 0)
  1097.                 sv_setpvn(ST(0), value.data, value.size);
  1098.         }
  1099.     }
  1100.     }
  1101.     XSRETURN(1);
  1102. }
  1103.  
  1104. XS(XS_DB_File_push)
  1105. {
  1106.     dXSARGS;
  1107.     if (items < 1) {
  1108.     croak("Usage: DB_File::push(db, ...)");
  1109.     }
  1110.     {
  1111.     DB_File    db;
  1112.     I32    RETVAL;
  1113.  
  1114.     if (sv_isa(ST(0), "DB_File")) {
  1115.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1116.         db = (DB_File) tmp;
  1117.     }
  1118.     else
  1119.         croak("db is not of type DB_File");
  1120.     {
  1121.         DBTKEY    key ;
  1122.         DBT        value ;
  1123.         int        i ;
  1124.  
  1125.         /* Set the Cursor to the Last element */
  1126.         RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
  1127.         if (RETVAL == 0)
  1128.         {
  1129.         /* for (i = 1 ; i < items ; ++i) */
  1130.         for (i = items - 1 ; i > 0 ; --i)
  1131.         {
  1132.             value.data = SvPV(ST(i), na) ;
  1133.             value.size = na ;
  1134.             RETVAL = (db->put)(db, &key, &value, R_IAFTER) ;
  1135.             if (RETVAL != 0)
  1136.                 break;
  1137.         }
  1138.         }
  1139.     }
  1140.     ST(0) = sv_newmortal();
  1141.     sv_setiv(ST(0), (IV)RETVAL);
  1142.     }
  1143.     XSRETURN(1);
  1144. }
  1145.  
  1146. XS(XS_DB_File_length)
  1147. {
  1148.     dXSARGS;
  1149.     if (items != 1) {
  1150.     croak("Usage: DB_File::length(db)");
  1151.     }
  1152.     {
  1153.     DB_File    db;
  1154.     I32    RETVAL;
  1155.  
  1156.     if (sv_isa(ST(0), "DB_File")) {
  1157.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1158.         db = (DB_File) tmp;
  1159.     }
  1160.     else
  1161.         croak("db is not of type DB_File");
  1162.         RETVAL = GetArrayLength(db) ;
  1163.     ST(0) = sv_newmortal();
  1164.     sv_setiv(ST(0), (IV)RETVAL);
  1165.     }
  1166.     XSRETURN(1);
  1167. }
  1168.  
  1169. XS(XS_DB_File_db_del)
  1170. {
  1171.     dXSARGS;
  1172.     if (items < 2 || items > 3) {
  1173.     croak("Usage: DB_File::del(db, key, flags=0)");
  1174.     }
  1175.     {
  1176.     DB_File    db;
  1177.     DBTKEY    key;
  1178.     u_int    flags;
  1179.     int    RETVAL;
  1180.  
  1181.     if (sv_isa(ST(0), "DB_File")) {
  1182.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1183.         db = (DB_File) tmp;
  1184.     }
  1185.     else
  1186.         croak("db is not of type DB_File");
  1187.  
  1188.     if (db->close != DB_recno_close)
  1189.     {
  1190.         key.data = SvPV(ST(1), na);
  1191.         key.size = (int)na;
  1192.     }
  1193.     else
  1194.     {
  1195.         Value =  SvIV(ST(1)) ; 
  1196.         ++ Value ; 
  1197.         key.data = & Value; 
  1198.         key.size = (int)sizeof(recno_t);
  1199.     };
  1200.  
  1201.     if (items < 3)
  1202.         flags = 0;
  1203.     else {
  1204.         flags = (unsigned int)SvIV(ST(2));
  1205.     }
  1206.  
  1207.     RETVAL = db_del(db, key, flags);
  1208.     ST(0) = sv_newmortal();
  1209.     sv_setiv(ST(0), (IV)RETVAL);
  1210.     }
  1211.     XSRETURN(1);
  1212. }
  1213.  
  1214. XS(XS_DB_File_db_get)
  1215. {
  1216.     dXSARGS;
  1217.     if (items < 3 || items > 4) {
  1218.     croak("Usage: DB_File::get(db, key, value, flags=0)");
  1219.     }
  1220.     {
  1221.     DB_File    db;
  1222.     DBTKEY    key;
  1223.     DBT    value;
  1224.     u_int    flags;
  1225.     int    RETVAL;
  1226.  
  1227.     if (sv_isa(ST(0), "DB_File")) {
  1228.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1229.         db = (DB_File) tmp;
  1230.     }
  1231.     else
  1232.         croak("db is not of type DB_File");
  1233.  
  1234.     if (db->close != DB_recno_close)
  1235.     {
  1236.         key.data = SvPV(ST(1), na);
  1237.         key.size = (int)na;
  1238.     }
  1239.     else
  1240.     {
  1241.         Value =  SvIV(ST(1)) ; 
  1242.         ++ Value ; 
  1243.         key.data = & Value; 
  1244.         key.size = (int)sizeof(recno_t);
  1245.     };
  1246.  
  1247.     value.data = SvPV(ST(2), na);
  1248.     value.size = (int)na;;
  1249.  
  1250.     if (items < 4)
  1251.         flags = 0;
  1252.     else {
  1253.         flags = (unsigned int)SvIV(ST(3));
  1254.     }
  1255.  
  1256.     RETVAL = db_get(db, key, value, flags);
  1257.     ST(0) = sv_newmortal();
  1258.     sv_setiv(ST(0), (IV)RETVAL);
  1259.     OutputValue(ST(2), value)
  1260.     }
  1261.     XSRETURN(1);
  1262. }
  1263.  
  1264. XS(XS_DB_File_db_put)
  1265. {
  1266.     dXSARGS;
  1267.     if (items < 3 || items > 4) {
  1268.     croak("Usage: DB_File::put(db, key, value, flags=0)");
  1269.     }
  1270.     {
  1271.     DB_File    db;
  1272.     DBTKEY    key;
  1273.     DBT    value;
  1274.     u_int    flags;
  1275.     int    RETVAL;
  1276.  
  1277.     if (sv_isa(ST(0), "DB_File")) {
  1278.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1279.         db = (DB_File) tmp;
  1280.     }
  1281.     else
  1282.         croak("db is not of type DB_File");
  1283.  
  1284.     if (db->close != DB_recno_close)
  1285.     {
  1286.         key.data = SvPV(ST(1), na);
  1287.         key.size = (int)na;
  1288.     }
  1289.     else
  1290.     {
  1291.         Value =  SvIV(ST(1)) ; 
  1292.         ++ Value ; 
  1293.         key.data = & Value; 
  1294.         key.size = (int)sizeof(recno_t);
  1295.     };
  1296.  
  1297.     value.data = SvPV(ST(2), na);
  1298.     value.size = (int)na;;
  1299.  
  1300.     if (items < 4)
  1301.         flags = 0;
  1302.     else {
  1303.         flags = (unsigned int)SvIV(ST(3));
  1304.     }
  1305.  
  1306.     RETVAL = db_put(db, key, value, flags);
  1307.     ST(0) = sv_newmortal();
  1308.     sv_setiv(ST(0), (IV)RETVAL);
  1309.     if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
  1310.     }
  1311.     XSRETURN(1);
  1312. }
  1313.  
  1314. XS(XS_DB_File_db_fd)
  1315. {
  1316.     dXSARGS;
  1317.     if (items != 1) {
  1318.     croak("Usage: DB_File::fd(db)");
  1319.     }
  1320.     {
  1321.     DB_File    db;
  1322.     int    RETVAL;
  1323.  
  1324.     if (sv_isa(ST(0), "DB_File")) {
  1325.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1326.         db = (DB_File) tmp;
  1327.     }
  1328.     else
  1329.         croak("db is not of type DB_File");
  1330.  
  1331.     RETVAL = db_fd(db);
  1332.     ST(0) = sv_newmortal();
  1333.     sv_setiv(ST(0), (IV)RETVAL);
  1334.     }
  1335.     XSRETURN(1);
  1336. }
  1337.  
  1338. XS(XS_DB_File_db_sync)
  1339. {
  1340.     dXSARGS;
  1341.     if (items < 1 || items > 2) {
  1342.     croak("Usage: DB_File::sync(db, flags=0)");
  1343.     }
  1344.     {
  1345.     DB_File    db;
  1346.     u_int    flags;
  1347.     int    RETVAL;
  1348.  
  1349.     if (sv_isa(ST(0), "DB_File")) {
  1350.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1351.         db = (DB_File) tmp;
  1352.     }
  1353.     else
  1354.         croak("db is not of type DB_File");
  1355.  
  1356.     if (items < 2)
  1357.         flags = 0;
  1358.     else {
  1359.         flags = (unsigned int)SvIV(ST(1));
  1360.     }
  1361.  
  1362.     RETVAL = db_sync(db, flags);
  1363.     ST(0) = sv_newmortal();
  1364.     sv_setiv(ST(0), (IV)RETVAL);
  1365.     }
  1366.     XSRETURN(1);
  1367. }
  1368.  
  1369. XS(XS_DB_File_db_seq)
  1370. {
  1371.     dXSARGS;
  1372.     if (items != 4) {
  1373.     croak("Usage: DB_File::seq(db, key, value, flags)");
  1374.     }
  1375.     {
  1376.     DB_File    db;
  1377.     DBTKEY    key;
  1378.     DBT    value;
  1379.     u_int    flags = (unsigned int)SvIV(ST(3));
  1380.     int    RETVAL;
  1381.  
  1382.     if (sv_isa(ST(0), "DB_File")) {
  1383.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  1384.         db = (DB_File) tmp;
  1385.     }
  1386.     else
  1387.         croak("db is not of type DB_File");
  1388.  
  1389.     if (db->close != DB_recno_close)
  1390.     {
  1391.         key.data = SvPV(ST(1), na);
  1392.         key.size = (int)na;
  1393.     }
  1394.     else
  1395.     {
  1396.         Value =  SvIV(ST(1)) ; 
  1397.         ++ Value ; 
  1398.         key.data = & Value; 
  1399.         key.size = (int)sizeof(recno_t);
  1400.     };
  1401.  
  1402.     value.data = SvPV(ST(2), na);
  1403.     value.size = (int)na;;
  1404.  
  1405.     RETVAL = db_seq(db, key, value, flags);
  1406.     ST(0) = sv_newmortal();
  1407.     sv_setiv(ST(0), (IV)RETVAL);
  1408.     OutputKey(ST(1), key)
  1409.     OutputValue(ST(2), value)
  1410.     }
  1411.     XSRETURN(1);
  1412. }
  1413.  
  1414. XS(boot_DB_File)
  1415. {
  1416.     dXSARGS;
  1417.     char* file = __FILE__;
  1418.  
  1419.     newXS("DB_File::constant", XS_DB_File_constant, file);
  1420.     newXS("DB_File::TIEHASH", XS_DB_File_db_TIEHASH, file);
  1421.     newXS("DB_File::DESTROY", XS_DB_File_db_DESTROY, file);
  1422.     newXS("DB_File::DELETE", XS_DB_File_db_DELETE, file);
  1423.     newXS("DB_File::FETCH", XS_DB_File_db_FETCH, file);
  1424.     newXS("DB_File::STORE", XS_DB_File_db_STORE, file);
  1425.     newXS("DB_File::FIRSTKEY", XS_DB_File_db_FIRSTKEY, file);
  1426.     newXS("DB_File::NEXTKEY", XS_DB_File_db_NEXTKEY, file);
  1427.     newXS("DB_File::unshift", XS_DB_File_unshift, file);
  1428.     newXS("DB_File::pop", XS_DB_File_pop, file);
  1429.     newXS("DB_File::shift", XS_DB_File_shift, file);
  1430.     newXS("DB_File::push", XS_DB_File_push, file);
  1431.     newXS("DB_File::length", XS_DB_File_length, file);
  1432.     newXS("DB_File::del", XS_DB_File_db_del, file);
  1433.     newXS("DB_File::get", XS_DB_File_db_get, file);
  1434.     newXS("DB_File::put", XS_DB_File_db_put, file);
  1435.     newXS("DB_File::fd", XS_DB_File_db_fd, file);
  1436.     newXS("DB_File::sync", XS_DB_File_db_sync, file);
  1437.     newXS("DB_File::seq", XS_DB_File_db_seq, file);
  1438.  
  1439.     /* Initialisation Section */
  1440.  
  1441.     newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
  1442.  
  1443.  
  1444.     /* End of Initialisation Section */
  1445.  
  1446.     ST(0) = &sv_yes;
  1447.     XSRETURN(1);
  1448. }
  1449.